home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / network.swg / 0007_NETINFO Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-08-17  |  7.6 KB  |  389 lines
  1. PROGRAM NetInfo;
  2. USES Crt, Dos;
  3. CONST
  4.  Redirector = $08;
  5.  Receiver   = $80;
  6.  Messenger  = $04;
  7.  Server     = $40;
  8.  AnyType    = $CC;
  9.  
  10. TYPE
  11.  String15 = STRING[15];
  12.  LocalDevice = ARRAY[1..16] OF Char;
  13.  RedirDevice = ARRAY[1..128] OF Char;
  14.  DevicePtr = ^DevInfo;
  15.  DevInfo = RECORD
  16.    LD : LocalDevice;
  17.    RD : RedirDevice;
  18.    ND : DevicePtr
  19.  END;
  20.  
  21. VAR Done:Boolean;
  22.     Name:String15;
  23.     Ver:Word;
  24.     I,Key:Integer;
  25.     DevIn:STRING[16];
  26.     RedIn:STRING[128];
  27.     LDevice:LocalDevice;
  28.     RDevice:RedirDevice;
  29.     DeviceList,NextDevice : DevicePtr;
  30.  
  31. PROCEDURE ClrCursor;
  32. VAR Regs : Registers;
  33. BEGIN
  34.  Regs.CH:=$20;
  35.  Regs.AH:=$01;
  36.  INTR($10,Regs);
  37. END;
  38.  
  39. PROCEDURE SetCursor;
  40. VAR Regs : Registers;
  41. BEGIN
  42.  Regs.AH:=1;
  43.  IF LastMode <> Mono THEN
  44.   BEGIN
  45.    Regs.CH:=6;
  46.    Regs.CL:=7
  47.   END
  48.  ELSE
  49.   BEGIN
  50.    Regs.CH:=12;
  51.    Regs.CL:=13
  52.   END;
  53.  INTR($10,Regs);
  54. END;
  55.  
  56. FUNCTION GetExtended : Integer;
  57. VAR CH:Char;
  58. BEGIN
  59.  CH:=#0;GetExtended:=0;CH:=ReadKey;
  60.  IF Ord(CH)=0 THEN
  61.    BEGIN
  62.      CH:=ReadKey;
  63.      GetExtended:=Ord(CH)
  64.    END
  65. END;
  66.  
  67. FUNCTION GetFileName(S:STRING):STRING;
  68. VAR FileName:STRING[11];
  69.     I:Integer;
  70. BEGIN
  71.  FileName:='';
  72.  I:=1;
  73.  WHILE S[I]<>#0 DO
  74.   BEGIN
  75.    FileName[I]:=(S[I]);
  76.    I:=I+1
  77.   END;
  78.  FileName[0]:=Chr(i-1);
  79.  GetFileName:=FileName
  80. END;
  81.  
  82. FUNCTION ChkNetInterface : Boolean;
  83. VAR NetRegs:Registers;
  84. BEGIN
  85.  NetRegs.AH:=$00;
  86.  INTR($2A,NetRegs);
  87.  IF NetRegs.AH = 0 THEN ChkNetInterface:=FALSE
  88. END;
  89.  
  90. PROCEDURE ChkPCLan;
  91. VAR NetRegs:Registers;
  92.     ChkType:Integer;
  93. BEGIN
  94.  NetRegs.AX:=$B800;
  95.  INTR($2F,NetRegs);
  96.  IF NetRegs.AH = 0 THEN
  97.    WriteLn('Network Not Installed')
  98.  ELSE
  99.   BEGIN
  100.    ChkType:= NetRegs.BL AND AnyType;
  101.    IF (ChkType AND Server > 0) THEN
  102.     WriteLn('Server')
  103.    ELSE
  104.    IF (ChkType AND Messenger > 0) THEN
  105.     WriteLn('Messenger')
  106.    ELSE
  107.    IF (ChkType AND Receiver > 0) THEN
  108.     WriteLn('Receiver')
  109.    ELSE
  110.    IF (ChkType AND Redirector > 0) THEN
  111.     WriteLn('Redirector')
  112.    ELSE
  113.     WriteLn('Unknown Type')
  114.   END
  115. END;
  116.  
  117. FUNCTION NetName : String15;
  118. VAR NetRegs:Registers;
  119.     Name:ARRAY[1..15] OF Char;
  120.  
  121. BEGIN
  122.  WITH NetRegs DO
  123.   BEGIN
  124.    AH:=$5E;
  125.    AL:=$00;
  126.    DS:=Seg(Name);
  127.    DX:=Ofs(Name)
  128.   END;
  129.  MsDos(NetRegs);
  130.  IF NetRegs.CH<>0 THEN
  131.   NetName:=Name
  132.  ELSE
  133.   NetName:='NOT DEFINED'
  134. END;
  135.  
  136. FUNCTION ChkDrive(DriveNo:Integer):Integer;
  137. VAR DriveRegs: Registers;
  138. BEGIN
  139.  WITH DriveRegs DO
  140.   BEGIN
  141.    AH:=$44;
  142.    AL:=$09;
  143.    BL:=DriveNo;
  144.    MsDos(DriveRegs);
  145.    IF (FLAGS AND 1) = 0 THEN
  146.     IF (DX AND $1000) = $1000 THEN
  147.      ChkDrive := 1
  148.     ELSE
  149.      ChkDrive := 0
  150.    ELSE
  151.     ChkDrive := AX * -1
  152.   END
  153. END;
  154.  
  155. FUNCTION GetDevices: DevicePtr;
  156. VAR NetRegs: Registers;
  157.     FstDevice, CurDevice,NewDevice : DevicePtr;
  158.     DevName: LocalDevice;
  159.     RedName: RedirDevice;
  160.     NextDev: Integer;
  161.     More : Boolean;
  162.  
  163. BEGIN
  164. More:=TRUE;
  165. FstDevice:=NIL;
  166. CurDevice:=NIL;
  167. NextDev:=0;
  168. WHILE More DO
  169. BEGIN
  170.  WITH NetRegs DO
  171.   BEGIN
  172.    AH:=$5F;
  173.    AL:=$02;
  174.    BX:=NextDev;
  175.    DS:=Seg(DevName);
  176.    SI:=Ofs(DevName);
  177.    ES:=Seg(RedName);
  178.    DI:=Ofs(RedName)
  179.   END;
  180.  MsDos(NetRegs);
  181.  IF (NetRegs.FLAGS AND 1) = 1 THEN
  182.   More:=FALSE
  183.  ELSE
  184.  BEGIN
  185.   NEW(NewDevice);
  186.   NewDevice^.LD:=DevName;
  187.   NewDevice^.RD:=RedName;
  188.   NewDevice^.ND:=NIL;
  189.   IF (CurDevice = NIL) AND (FstDevice=NIL) THEN
  190.     BEGIN
  191.      CurDevice:=NewDevice;
  192.      FstDevice:=NewDevice
  193.     END
  194.   ELSE
  195.     BEGIN
  196.      CurDevice^.ND:=NewDevice;
  197.      CurDevice:=NewDevice
  198.     END;
  199.   Inc(NextDev)
  200.  END
  201. END;
  202. GetDevices:=FstDevice
  203. END;
  204.  
  205. PROCEDURE AssignDevice(DevName:LocalDevice;
  206.                        RedName:RedirDevice);
  207. VAR NetRegs: Registers;
  208.     DevType: Byte;
  209.     Dummy  : Integer;
  210.  
  211. BEGIN
  212. IF Pos(':',DevName)=2 THEN
  213.   DevType:=4
  214.  ELSE
  215.   DevType:=3;
  216.  
  217.  WITH NetRegs DO
  218.   BEGIN
  219.    AH:=$5F;
  220.    AL:=$03;
  221.    BL:=DevType;
  222.    CX:=0;
  223.    DS:=Seg(DevName);
  224.    SI:=Ofs(DevName);
  225.    ES:=Seg(RedName);
  226.    DI:=Ofs(RedName)
  227.   END;
  228.  MsDos(NetRegs);
  229.  IF (NetRegs.FLAGS AND 1) = 1 THEN
  230.   BEGIN
  231.    TextColor(Red);GotoXY(WhereX+6,WhereY);
  232.    WriteLn('An Error Occurred on Assign');
  233.    TextColor(Red+128);GotoXY(WhereX+13,WhereY);
  234.    Write('Press Any Key');
  235.    Dummy:=GetExtended;
  236.    TextColor(White);
  237.    ClrScr
  238.   END
  239. END;
  240.  
  241. PROCEDURE DeleteDevice(DevName:LocalDevice);
  242. VAR NetRegs: Registers;
  243.     Dummy  : Integer;
  244.  
  245. BEGIN
  246.  WITH NetRegs DO
  247.   BEGIN
  248.    AH:=$5F;
  249.    AL:=$04;
  250.    DS:=Seg(DevName);
  251.    SI:=Ofs(DevName)
  252.   END;
  253.  MsDos(NetRegs);
  254.  IF (NetRegs.FLAGS AND 1) = 1 THEN
  255.   BEGIN
  256.    TextColor(Red);GotoXY(WhereX+6,WhereY);
  257.    WriteLn('An Error Occurred on Delete');
  258.    TextColor(Red+128);GotoXY(WhereX+13,WhereY);
  259.    Write('Press Any Key');
  260.    Dummy:=GetExtended;
  261.    TextColor(White);
  262.    ClrScr
  263.   END
  264. END;
  265.  
  266. FUNCTION SrchDevice(Drive:LocalDevice):DevicePtr;
  267. VAR NDevice:DevicePtr;
  268. BEGIN
  269.  NDevice:=GetDevices;
  270.  WHILE (NDevice <> NIL) AND
  271.        (Copy(NDevice^.LD,1,3) <>
  272.         Copy(Drive,1,3)) DO
  273.   BEGIN
  274.    NDevice:=NDevice^.ND
  275.   END;
  276. SrchDevice:=NDevice
  277. END;
  278.  
  279. PROCEDURE DisplayDrives;
  280. VAR I:Integer;
  281.     LDevice:LocalDevice;
  282.     NextDevice : DevicePtr;
  283. BEGIN
  284.  FOR I:=1 TO 26 DO
  285.   BEGIN
  286.    CASE ChkDrive(I) OF
  287.     0 : BEGIN
  288.          Write(#32,#32,Chr(64+I),':');
  289.          GotoXY(WhereX+3,WhereY);
  290.          WriteLn('Local')
  291.         END;
  292.     1 : BEGIN
  293.          Write(#32,#32,Chr(64+I),':');
  294.          GotoXY(WhereX+3,WhereY);
  295.          Write('Remote');
  296.          LDevice[1]:=Chr(64+I);
  297.          LDevice[2]:=':';
  298.          LDevice[3]:=#0;
  299.          NextDevice:=SrchDevice(LDevice);
  300.          GotoXY(WhereX+7,WhereY);
  301.          WITH NextDevice^ DO
  302.           WriteLn(Copy(RD,1,Pos(#0,RD)))
  303.         END
  304.    END
  305.   END
  306. END;
  307.  
  308. PROCEDURE ScrnSetup;
  309. BEGIN
  310.  ClrCursor;
  311.  TextBackground(Blue);
  312.  TextColor(White);
  313.  ClrScr;
  314.  GotoXY(30,2);Write('Network Status');
  315.  TextColor(LightGray);
  316.  GotoXY(2,5);Write('Dos Version:');
  317.  GotoXY(21,5);Write('Network Name:');
  318.  GotoXY(51,5);Write('Node Type:');
  319.  TextColor(White);
  320.  GotoXY(31,7);Write('Drive Status');
  321.  TextColor(LightGray);
  322.  GotoXY(20,9);Write('Drive');
  323.  GotoXY(27,9);Write('Location');
  324.  GotoXY(40,9);Write('Connection');
  325.  GotoXY(15,25);Write('F1 - Assign Device');
  326.  GotoXY(35,25);Write('F2 - Delete Device');
  327.  GotoXY(55,25);Write('F10 - Exit');
  328.  TextBackground(Black);
  329.  Ver:=DosVersion;
  330.  GotoXY(15,5);
  331.  WriteLn(Lo(Ver),'.',Hi(Ver))
  332. END;
  333.  
  334. PROCEDURE SetScreen(W,X,Y,Z,Back,Txt:Integer);
  335. BEGIN
  336.  Window(W,X,Y,Z);
  337.  TextColor(Txt);
  338.  TextBackground(Back);
  339.  ClrScr
  340. END;
  341.  
  342. BEGIN
  343.  ScrnSetup;
  344.  IF ChkNetInterface THEN
  345.   BEGIN
  346.     GotoXY(35,5); WriteLn(NetName);GotoXY(62,5);
  347.     ChkPCLan;
  348.     Window(20,10,60,20);ClrScr;
  349.     DisplayDrives;
  350.     REPEAT
  351.      SetScreen(20,21,60,24,Blue,White);
  352.      Key:=GetExtended;
  353.      CASE Key OF
  354.        59:BEGIN
  355.            SetCursor;
  356.            Write('Drive to Redirect  ');
  357.            ReadLn(DevIn);
  358.            Write('Remote Definition  ');
  359.            ReadLn(RedIn);
  360.            ClrCursor;
  361.            FOR I:= 1 TO Ord(DevIn[0]) DO
  362.             LDevice[I]:=DevIn[I];
  363.            LDevice[Ord(DevIn[0])+1]:=#0;
  364.            FOR I:= 1 TO Ord(RedIn[0]) DO
  365.             RDevice[I]:=RedIn[I];
  366.            RDevice[Ord(RedIn[0])+1]:=#0;
  367.            AssignDevice(LDevice,RDevice)
  368.           END;
  369.        60:BEGIN
  370.            Write('Drive to Delete    ');
  371.            SetCursor;
  372.            ReadLn(DevIn);
  373.            ClrCursor;
  374.            FOR I:= 1 TO Ord(DevIn[0]) DO
  375.             LDevice[I]:=DevIn[I];
  376.            LDevice[Ord(DevIn[0])+1]:=#0;
  377.            DeleteDevice(LDevice)
  378.           END
  379.      END;
  380.      SetScreen(20,10,60,20,Black,LightGray);
  381.      DisplayDrives;
  382.     UNTIL Key = 68;
  383.  
  384.   END
  385.  ELSE
  386.     WriteLn('NetBIOS Interface Not Available')
  387. END.
  388.  
  389.